Board_Games_Regression_Project

Introducción

José es un diseñador de juegos de mesa. Crea las reglas, diseña los gráficos, escoge su tema, número de jugadores y duración promedio del juego que tiene en mente. José es una persona tímida, y a pesar de que sus juegos suelen gustarle a sus amigos, él nunca ha querido publicarlos por miedo a que no sean bien recibidos. Se quiere demostrar a José, con una base de datos de calificaciones históricas de juegos de mesa, cómo hubieran sido recibidos sus juegos en promedio en la época que los fue creando.

Los datos a utilizar vienen de esta base de datos: (board_games)* que, en cambio, vienen de la página Board Game Geek.

Instalación de Paquetes

Procedemos para empezar en instalar los siguientes paquetes, se puede omitir este paso si ya se tienen previamente instalados. Aquí una lista de los cuales vamos a necesitar.

#install.packages("data.table")
#install.packages("h2o")
#install.packages("ggplot2")
#install.packages("ggthemes")
#install.packages("data.tree")
#install.packages("tidyverse")
#install.packages("modeldata")
#install.packages("DataExplorer")
#install.packages("vtree")
#install.packages("caTools")
#install.packages("rpart")
#install.packages("rpart.plot")
#install.packages("lares")

Cargar Librerías

Usando ‘library’ cargamos las librerías, con las cuales vas a hacer uso de las diferentes funciones.

library("data.table")

package 㤼㸱data.table㤼㸲 was built under R version 4.0.5Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
data.table 1.14.0 using 4 threads (see ?getDTthreads).  Latest news: r-datatable.com

library("h2o")

package 㤼㸱h2o㤼㸲 was built under R version 4.0.5
----------------------------------------------------------------------

Your next step is to start H2O:
    > h2o.init()

For H2O package documentation, ask for help:
    > ??h2o

After starting H2O, you can use the Web UI at http://localhost:54321
For more information visit https://docs.h2o.ai

----------------------------------------------------------------------


Attaching package: 㤼㸱h2o㤼㸲

The following objects are masked from 㤼㸱package:data.table㤼㸲:

    hour, month, week, year

The following objects are masked from 㤼㸱package:stats㤼㸲:

    cor, sd, var

The following objects are masked from 㤼㸱package:base㤼㸲:

    %*%, %in%, &&, ||, apply, as.factor, as.numeric, colnames,
    colnames<-, ifelse, is.character, is.factor, is.numeric, log,
    log10, log1p, log2, round, signif, trunc

library("ggplot2")

package 㤼㸱ggplot2㤼㸲 was built under R version 4.0.5

library("ggthemes")

package 㤼㸱ggthemes㤼㸲 was built under R version 4.0.5

library("data.tree")

package 㤼㸱data.tree㤼㸲 was built under R version 4.0.5

library("tidyverse")

package 㤼㸱tidyverse㤼㸲 was built under R version 4.0.5Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
-- Attaching packages -------------------------------------- tidyverse 1.3.1 --
v tibble  3.1.0     v dplyr   1.0.5
v tidyr   1.1.3     v stringr 1.4.0
v readr   1.4.0     v forcats 0.5.1
v purrr   0.3.4     
package 㤼㸱tidyr㤼㸲 was built under R version 4.0.5package 㤼㸱readr㤼㸲 was built under R version 4.0.5package 㤼㸱purrr㤼㸲 was built under R version 4.0.5package 㤼㸱dplyr㤼㸲 was built under R version 4.0.5package 㤼㸱stringr㤼㸲 was built under R version 4.0.5package 㤼㸱forcats㤼㸲 was built under R version 4.0.5-- Conflicts ----------------------------------------- tidyverse_conflicts() --
x dplyr::between()   masks data.table::between()
x dplyr::filter()    masks stats::filter()
x dplyr::first()     masks data.table::first()
x dplyr::lag()       masks stats::lag()
x dplyr::last()      masks data.table::last()
x purrr::transpose() masks data.table::transpose()

library("modeldata")

package 㤼㸱modeldata㤼㸲 was built under R version 4.0.5

library("DataExplorer")

package 㤼㸱DataExplorer㤼㸲 was built under R version 4.0.5Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

library("vtree")

package 㤼㸱vtree㤼㸲 was built under R version 4.0.5

library("caTools")

package 㤼㸱caTools㤼㸲 was built under R version 4.0.5

library("rpart")

package 㤼㸱rpart㤼㸲 was built under R version 4.0.5

library("rpart.plot")

package 㤼㸱rpart.plot㤼㸲 was built under R version 4.0.5

library("lares")

package 㤼㸱lares㤼㸲 was built under R version 4.0.5

Ánalisis Descriptivo, Data Engineering

Leemos nuestro dataset

En este caso usamos read.csv. Procedemos a leer:

board_games <- read.csv("./board_games.csv") 

Observación de las primeras líneas

• game_id Identificador único
• description Descripción corta
• image URL con imagen del juego
• max_players Jugadores máximos
• max_playtime Tiempo máximo de juego
• min_age Edad mínima
• min_players Jugadores mínimos
• min_playtime Tiempo mínimo de juego
• name Nombre del juego
• playing_time Tiempo promedio de juego
• thumbnail URL con thumbnail del juego
• year_published Año de publicación
• artist Diseñador gráfico del juego
• category Categorías del juego (separadas por coma)
• compilation Si es parte de una compilación, nombre de la compilación
• designer Diseñador del juego
• expansion Si hay una expansión, el nombre de la expansión
• family Familia, equivalente a editora
• mechanic Mecánicas, separadas por coma
• publisher Compañía o persona que publicaron el juego (separadas por coma)
• average_rating Calificación promedio en Board Game Geek
• users_rated Número de usuarios que calificaron el juego

head(board_games)

Colnames de nuestro dataset

Después de una rápida observación, ejecutamos los siguientes comandos para confirmación:

colnames(board_games)

 [1] "game_id"        "description"    "image"          "max_players"   
 [5] "max_playtime"   "min_age"        "min_players"    "min_playtime"  
 [9] "name"           "playing_time"   "thumbnail"      "year_published"
[13] "artist"         "category"       "compilation"    "designer"      
[17] "expansion"      "family"         "mechanic"       "publisher"     
[21] "average_rating" "users_rated"   

Tipo de variables

Usando data explorer observamos el tipo de variables, casi tenemos el mismo porcentaje para las discretas y continua, y tenemos un bajo porcentaje de missing values:

• Sólo el 0.99% de las filas están completas,
• tenemos 11.54% de observaciones faltantes, es decir, dado que solo tenemos 0.99% de las filas completas, solo hay 10.55% de observaciones faltantes del total.

Estos valores faltantes nos podrán general problemas para analizar los datos, veamos un poco los perfiles que faltan.

plot_intro(board_games)

Missing plot

Para visualizar el perfil de los datos faltantes podemos utilizar la función plot_missing(). En la visualización debajo, podemos ver que la variables compilation y expansion, son las que les falta información, encontramos de que sólo el 2.63% (compilation), 16.54% (expansion) de nuestras filas estén completas y probablemente esta varible no sea de mucha infomación. Por tanto la podemos eliminar de nuestro dataframe, ahorita mismo!!

plot_missing(board_games)

Eliminamos la columna que tiene más missing values

Eliminamos compilation y expansion de nuestro dataframe:

final_board_games <- drop_columns(board_games, c("description", "image", "name", "thumbnail", "game_id", "compilation","expansion", "family", "artist", "mechanic"))
final_board_games <- drop_columns(final_board_games, c("designer", "publisher"))
colnames(final_board_games)

 [1] "max_players"    "max_playtime"   "min_age"        "min_players"   
 [5] "min_playtime"   "playing_time"   "year_published" "category"      
 [9] "average_rating" "users_rated"   

final_board_games <- na.omit(final_board_games) 

Ánalisis de Correlación

Podemos ver la más alta correlación en estas variables:

• min_playtime-max_playtime
• min_playtime-min_age
• min_playtime-playing_time
• average_rating-min_age

plot_correlation(na.omit(final_board_games), maxcat = 5L)

Ignored all discrete features since `maxcat` set to 5 categories!

Ahora de una manera más detallada vamos a analizar las variables más correlacionadas entre sí. El top 10:

corr_cross(final_board_games, # name of dataset
  max_pvalue = 0.05, # display only significant correlations (at 5% level)
  top = 10 # display top 10 couples of variables (by correlation coefficient)
)

Returning only the top 10. You may override with the 'top' argument
`guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> = "none")` instead.Font 'Arial Narrow' is not installed, has other name, or can't be found

QQ plot

La gráfica Quantile-Quantile es una forma de visualizar la desvisión de una distribución de probabilidad específica.

Después de analizar estos gráficos, a menudo es beneficioso aplicar una transformación matemática (como logaritmo) para modelos como la regresión lineal. Para hacerlo, podemos usar la función plot_qq. De forma predeterminada, se compara con la distribución normal.

qq_data <- final_board_games[, c("min_playtime", "max_playtime", "min_age", "playing_time", "average_rating")]

plot_qq(qq_data, sampled_rows = 1000L)

En el gráfico, las columnas parecen sesgadas en ambas colas. Apliquemos una transformación logarítmica simple y grafiquemos de nuevo.

log_qq_data <- update_columns(qq_data, 1:5, function(x) log(x + 1))


plot_qq(log_qq_data, sampled_rows = 1000L)

Ánalisis Exploratorio de los Datos

Teniendo nuestras variables con mayor correlación vamos a graficarlas con geom point..:

• min_playtime-min_age

final_board_games %>%  ggplot(aes(x = min_playtime, y = min_age)) + 
  geom_point()

• average_rating-min_age

final_board_games %>%  ggplot(aes(x = average_rating, y = min_age)) + 
  geom_point()

• average_rating-playing_time

final_board_games %>%  ggplot(aes(x = playing_time, y = average_rating)) + 
  geom_point()

• users_rated-average_rating

final_board_games %>%  ggplot(aes(x = users_rated, y = average_rating)) + 
  geom_point()

###Using vtree para explorar

Usamos vtree para observar la concentración de los datos por ejemplo para min_age, donde la mayoría de los datos se concentran en min_age de 8 años, 10 años y 12 años.

vtree(final_board_games, "min_age")

Usamos vtree para observar la concentración de los datos por ejemplo para min_players, tenemos casi un 69% para min 2 jugadores y cerca del 19% para min 3 jugadores.

vtree(final_board_games, "min_players")

Usamos vtree para observar la concentración de los datos por ejemplo para max_players, tenemos casi un 23% para máx 4 jugadores y cerca del 25% para máx 6 jugadores.

vtree(final_board_games, "max_players")

¿Que se ha hecho hasta ahora?

Se realizó una exploración de datos, donde primero eliminalos columnas que no tienen mucha significancia en la predicción de nuestra variable de calificación. Después vimos su correlación entre las existentes.

Se tiene más claro cuales son las variables más significativas a la predicción, se hizo una limpieza, tenemos datos más contundentes con los cuales comenzar nuestra predicción, menos outliers sobre todo.

Propuestas

Debido a que el problema intenta convencer a José de que sus juegos pudieron haber sido (en promedio) bien recibidos, y de cómo se espera que se reciban en un futuro, la variable de salida de nuestro problema es la calificación de los usuarios del sitio web. Esto puede hacerse de dos maneras: una regresión y tomar la calificación como una variable continua, o redondear y tomarlo como problema de clasificación (calificación discreta de 0 a 10). Las propuestas para estos casos son

Regresión

• Support Vector Regression
• Random Forest
• Regresión lineal múltiple

Clasificación

• Support Vector Machine
• Random Forest
• Multilayer perceptron

Vamos a suponer que a la comunidad de juegos de mesa no les importa tanto el historial del autor del juego ni quién lo publique, por lo que esas columnas se eliminarían del análisis. Si José ve que sus juegos no hubieran gustado, al menos podrá tener un modelo con el cuál puede saber qué es lo que suele gustarle a la gente, por lo que podría hacer investigación de seguimiento para entablar las causas raíces.

Modelado

Primero hacemos la separación de los datos en train y test. Todos los modelos usarán los mismos subconjuntos para poder evaluarlos y compararlos en un terreno nivelado.

library(caTools)
set.seed(0)
split = sample.split(final_board_games, SplitRatio=0.6)
data.train = subset(final_board_games, split=TRUE)
data.test = subset(final_board_games, split=FALSE)

Regresión

Support Vector Regression

library(caret)

package 㤼㸱caret㤼㸲 was built under R version 4.0.5Loading required package: lattice

Attaching package: 㤼㸱caret㤼㸲

The following object is masked from 㤼㸱package:purrr㤼㸲:

    lift

library(doParallel)

package 㤼㸱doParallel㤼㸲 was built under R version 4.0.5Loading required package: foreach
package 㤼㸱foreach㤼㸲 was built under R version 4.0.5
Attaching package: 㤼㸱foreach㤼㸲

The following objects are masked from 㤼㸱package:purrr㤼㸲:

    accumulate, when

Loading required package: iterators
package 㤼㸱iterators㤼㸲 was built under R version 4.0.5Loading required package: parallel

set.seed(0)
control = trainControl(method="repeatedcv", repeats=5, search="random")
registerDoParallel(cores = parallel::detectCores() - 1)
model.svr = train(average_rating ~ ., data = drop_columns(data.train, "category"),
               method = "svmRadial",
               tuneLength = 15,
               metric = "RMSE",
               preProc = c("center", "scale"),
               trControl = control)

1 package is needed for this model and is not installed. (kernlab). Would you like to try to install it now?
1: yes
2: no

yes

Installing package into 㤼㸱C:/Users/Adrian_Moreno/Documents/R/win-library/4.0㤼㸲
(as 㤼㸱lib㤼㸲 is unspecified)
trying URL 'https://cran.rstudio.com/bin/windows/contrib/4.0/kernlab_0.9-29.zip'
Content type 'application/zip' length 2849843 bytes (2.7 MB)
downloaded 2.7 MB

package ‘kernlab’ successfully unpacked and MD5 sums checked

The downloaded binary packages are in
    C:\Users\Adrian_Moreno\AppData\Local\Temp\RtmpSmk0mH\downloaded_packages

model.svr

Support Vector Machines with Radial Basis Function Kernel 

1200 samples
   8 predictor

Pre-processing: centered (8), scaled (8) 
Resampling: Cross-Validated (10 fold, repeated 5 times) 
Summary of sample sizes: 1080, 1080, 1080, 1080, 1080, 1080, ... 
Resampling results across tuning parameters:

  sigma       C             RMSE       Rsquared    MAE      
  0.01226831   45.77096245  0.5971698  0.28603519  0.4569200
  0.01450086  432.22566749  0.6077075  0.27828915  0.4600209
  0.01733709    0.08424009  0.6385926  0.22166352  0.4933061
  0.01797172    0.68418148  0.6089168  0.26137934  0.4676323
  0.01949306   53.19382628  0.5923793  0.29802023  0.4532379
  0.03197837   97.46893089  0.6050052  0.27990795  0.4595333
  0.04891373    0.09331815  0.6188100  0.25343570  0.4756074
  0.08517855    1.13103822  0.5900931  0.30271546  0.4517433
  0.09135066   15.15147202  0.5944384  0.29497671  0.4532882
  0.45152266  986.00398192  1.0261372  0.09002466  0.6915994
  0.61653904    0.15882372  0.6108620  0.26636552  0.4694599
  1.29998370   10.85267954  0.6525816  0.20588346  0.5030971
  1.34663993    0.16233196  0.6224801  0.24125207  0.4783713
  1.35594685    0.51325259  0.6090114  0.25717566  0.4658292
  4.87616608    0.47422243  0.6315189  0.20311225  0.4874107

RMSE was used to select the optimal model using the smallest value.
The final values used for the model were sigma = 0.08517855 and C = 1.131038.

plot_qq(predict(model.svr, newdata=data.test) - data.test$average_rating)

Random Forest

summary(model.h2o.rf)

Model Details:
==============

H2ORegressionModel: drf
Model Key:  rf_covType_v1 
Model Summary: 

H2ORegressionMetrics: drf
** Reported on training data. **
** Metrics reported on Out-Of-Bag training samples **

MSE:  0.3964666
RMSE:  0.6296559
MAE:  0.4730133
RMSLE:  0.09244608
Mean Residual Deviance :  0.3964666


H2ORegressionMetrics: drf
** Reported on validation data. **

MSE:  0.3367014
RMSE:  0.5802598
MAE:  0.4349905
RMSLE:  0.08385576
Mean Residual Deviance :  0.3367014




Scoring History: 

Variable Importances: (Extract with `h2o.varimp`) 
=================================================

Variable Importances: 

Gradient Boosting Machines (GBM)

summary(gbm_model)

Model Details:
==============

H2ORegressionModel: gbm
Model Key:  gbm_covType1 
Model Summary: 

H2ORegressionMetrics: gbm
** Reported on training data. **

MSE:  0.1976639
RMSE:  0.4445941
MAE:  0.3295525
RMSLE:  0.06661653
Mean Residual Deviance :  0.1976639


H2ORegressionMetrics: gbm
** Reported on validation data. **

MSE:  0.3537016
RMSE:  0.5947282
MAE:  0.4604384
RMSLE:  0.0842206
Mean Residual Deviance :  0.3537016




Scoring History: 

---

Variable Importances: (Extract with `h2o.varimp`) 
=================================================

Variable Importances: 

Clasificación

library(tidymodels)

data.train.discrete = data.train %>% mutate(discrete_rating = round(average_rating)) %>% drop_columns("average_rating")
data.test.discrete = data.test %>% mutate(discrete_rating = round(average_rating)) %>% drop_columns("average_rating")

rf = rand_forest(
  mode = "classification",
  trees = tune(),
  min_n = tune()
) %>% set_engine(engine = "randomForest")

transformer = recipe(
  formula = discrete_rating ~ .,
  data = data.train.discrete
)

cv_folds = vfold_cv(
  data = data.train.discrete,
  v = 5,
  strata = discrete_rating
)

workflow_modelado = workflow() %>%
  add_recipe(transformer) %>%
  add_model(rf)

hp_grid = grid_regular(
  trees(range = c(50L, 3000L), trans = NULL),
  min_n(range = c(2L, 100L), trans = NULL),
  levels = 5
)

registerDoParallel(cores = parallel::detectCores() - 1)

grid_fit = tune_bayes(
  workflow_modelado,
  resamples = cv_folds,
  initial = 20,
  iter = 30,
  control = control_bayes(no_improve = 20, verbose = FALSE)
)

Support Vector Machine

Random Forest